I. Introduction

• In this report we will explore and examine death sentencing/executions across the United States. The goal of this project is to find potential trends that could be underlying factors that would result in the death penalty. Such trends would include: which groups of people are more likely to be executed, how location affects sentencing and how these trends evolve over time. In our Exploratory Data Analysis (EDA), we realized we needed to focus our analysis on a smaller group of variables. This was especially prevalent due to the pairs plot. Thus, we chose to investigate which groups of people are more likely to be executed, how location affects sentencing and how these trends evolve over time. Furthermore, we would also look at motivators such as political affiliation.

II. Background

• We are using the Execution Database - U.S. Executions collected by the Death Penalty Information Center (DPIC). The data contains information for every person that was executed as a result of the death penalty. This information includes, date, region, crime type, and number of victims along with a multitude of other variables. As discussed in the introduction, we decided to examine the following variables: race, sex, region, volunteering, number of victims, and the race and sex of the victims. It is important to understand that this data does not include everyone that was sentenced to the death penalty. This excludes almost 2500 prisoners on death row, compared to the 1566 observations (executions) in our dataset. In addition, to better understand the data presented, it is important to note that states with the value of NA have not had the death penalty or any executions between 1977 and 2023. It is also important to note that Kansas has had executions, but no data was presented for them. There is also one person listed that has a 0 for number of victims. After further research, however, this person did commit a murder which can skew our data slightly.

III. Data Wrangling

• In the original data set we were given the variables whether they volunteered, number of victims, whether they were juvenile, first name, last name, middle name, race, sex, region, state, execution date, number of victims, and number of victims by race and sex. In order to utilize the dataset, we first had to convert the dataset from CSV and modify the dataset. For example, the year format only contained the last two digits, and some entries for sex were inconsistent due to spaces. Lastly, we then used this modified dataset as the basis for all further analysis. From the modified dataset, we created numerous sub-datasets based on the specific variables we wanted to analyze. For instance, we would take the modified dataset, group by gender and year, then count the number of executions. This gender dataset would then be graphed to show the trend between executions and gender. This process was then repeated for all the variables we examined. The code for these processes is located in the appendix.

knitr::opts_chunk$set(warning = FALSE, message = FALSE) 
#Convert CSV file to R.Data

data <- read.csv("DPIC Execution Database - U.S. Executions.csv")

data$Execution.Date <- as.Date(data$Execution.Date, "%m/%d/%Y")

#Convert the date column for the dataset into a usuable year column. Year was in 00/00/00 format so addition of 1900 or 2000 to get a logical year value. Then had to modify the Sex column as some entries where Male with a space in front.

updated_data <- data %>%
  # Create the year column based on execution.date
  mutate(year = as.numeric(format(data$Execution.Date,'%Y'))) %>%
  # Remove execution.date
  select(!Execution.Date)%>%
  # Modify the year column as the year was only represented as 2 digits
  mutate(year = if_else(year > 23, year + 1900, year + 2000))%>%
  # Fix the observations containing to Sex as some entries have a space character
  mutate(Sex = case_when(
    Sex == "Male" ~ "Male",
    Sex == " Male" ~ "Male",
    Sex == "Female" ~ "Female"
  )) %>%
  # Modify the race column by fixing incorrect entries and increase the "Other" category to include more racial groups
  # Very small amount of Asian/American Indian or Alaska Native criminals volunteered to be executed so just ignore         these
  mutate(Race = case_when(
    Race == "White" ~ "White",
    Race == " White" ~ "White",
    Race == "Black" ~ "Black",
    Race == "Latinx" ~ "Latinx",
    Race == "Asian" | Race == "Other" | Race == "American Indian or Alaska Native" ~ "Other"
  ))

IV. Exploratory Analysis

After looking at the pairs plot, we concluded that since our dataset contains a multide of variables many of which are categorical that is relatively unhelpful. The graph is too cluttered and hard to analyze that there is very little useful information gained from the plot. Thus, we had to analyze our data with a variety of graphs to best represent the data.

Executions since 1975 to 2023 the distribution follows the bell curve shape and peaks around 2000.

The male distribution seems to be symmetric across 2000, while the execution of females greatly rises and then declines.

The following graphs are executions of people by race over the years. Whites tend to make up approximately half of the total executions. Black and Whites follow an upward trend that peaked around 2000 and went back down.

We see that the majority of executions are White with 56%. The second highest group executed is Black with 35%. The other groups make up a small percentage compared to White and Black.

After getting the graph we can clearly see that the regions of South and Midwest have the most male volunteers to be executed.

The graphs show that the south had the most volunteered executions and it closely resembles the bell curve shape of the execution vs time graph.

After combining the regions, the North is more dense around the 2000s, and the South follows the bell curve

This chart shows the number of criminals that were sentenced by number of people fallen victim to his or her crime. The majority had one victim and good amount with two. We thought we would see an upward trend of more death sentences with more victims, but it was not the case. The graph is heavily skewed right.

The graphs show the victim’s race and gender across all the death sentences. It seems that White victims make up the majority of the death sentences, and the others are small in comparison

The graphs show the number of executions based on what the sex of the victim. It seems that female victims make up just a little more than the male victims. Both appear to follow a trend where executions went up and peaked around 2000 and then started trending downward.

Create Choropleth of the United States

This map shows all 50 states and colors each of them by the number of executions. It is a bit skewed because Texas is so much greater in the number of executions so it is hard to see some of the other states because the range is so great. Gray values represent the states that have had the death penalty outlawed since 1977, and other states have more recently made it illegal.

V. Finished Analysis

The death penalty has been a controversial topic for centuries. In the United States, it is a practice that has been used for hundreds of years, but it has been surrounded by controversy, debates, and legal challenges. This analysis will explore the death penalty from 1977 to 2023 and what has changed during this time.

VI. Conclusion

Before undertaking this project, our main goal was to find potential trends that result in the death penalty and what groups of people and regions are affected most. When we began looking at this data, we first started by creating graphs of executions over time. What we found is that until 2000 there was a steady increase of executions, and then it began to slowly decline. In this era of high execution rates, we learned that the cause is from southern states being more lenient to sentencing someone to death and expedited processes due to the Supreme Court. Many trials were not conducting as well as they should be with a premeditated ruling of the death sentence in some cases. Caucasian males also made up the majority of executions and Caucasian females made up the majority of homicides. Thus we found limited racial bias in executions. Finally we looked at regions and also learned that the south has a higher execution rate and homicide rate. When we look at political standing of states, red states do tend to have higher number of executions, but overall many blue states also have the death penalty. Additionally, we found that southern states have higher volunteering rates.

With additional time we would expand our analysis multiple ways. First we would include a data set with sentencing and convictions. This would allow us to truly compare receiving life in prison vs execution sentencing, as our current data set only includes people who were executed. We would need to compare the races of the victim and perpetrator to further investigate racial bias, maybe even on a state basis. Also, we could examine executions per capita as our political motivations were lacking. With the additional data, we could look for more detailed correlations.

VII. Appendix

knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 
#Load all necessary packages
library(tidyverse)
library(ggplot2)
library(dplyr)
library(sf)
library(ggthemes)
library(usmap)
library(gganimate)
library(plotly)
library(leaflet)
library(gapminder)
library(ggridges)
library(GGally)
library(gifski)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 
#Convert CSV file to R.Data

data <- read.csv("DPIC Execution Database - U.S. Executions.csv")

data$Execution.Date <- as.Date(data$Execution.Date, "%m/%d/%Y")

#Convert the date column for the dataset into a usuable year column. Year was in 00/00/00 format so addition of 1900 or 2000 to get a logical year value. Then had to modify the Sex column as some entries where Male with a space in front.

updated_data <- data %>%
  # Create the year column based on execution.date
  mutate(year = as.numeric(format(data$Execution.Date,'%Y'))) %>%
  # Remove execution.date
  select(!Execution.Date)%>%
  # Modify the year column as the year was only represented as 2 digits
  mutate(year = if_else(year > 23, year + 1900, year + 2000))%>%
  # Fix the observations containing to Sex as some entries have a space character
  mutate(Sex = case_when(
    Sex == "Male" ~ "Male",
    Sex == " Male" ~ "Male",
    Sex == "Female" ~ "Female"
  )) %>%
  # Modify the race column by fixing incorrect entries and increase the "Other" category to include more racial groups
  # Very small amount of Asian/American Indian or Alaska Native criminals volunteered to be executed so just ignore         these
  mutate(Race = case_when(
    Race == "White" ~ "White",
    Race == " White" ~ "White",
    Race == "Black" ~ "Black",
    Race == "Latinx" ~ "Latinx",
    Race == "Asian" | Race == "Other" | Race == "American Indian or Alaska Native" ~ "Other"
  ))
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

#Group the entries by year and then find the number of executions per year
yearly_executions <- updated_data %>%
      group_by(year) %>%
      summarize(Executions = n())
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Create a new dataset with the modified Execution.Volunteer variable and then group by Region, Execution.Volunteer, Race, and Sex with Executions of "Volunteers" and "Others".
exec_volunteer_region.race <- updated_data %>%
  select(Execution.Volunteer, Race, Sex, Region, State) %>%
  mutate(Execution.Volunteer = if_else(Execution.Volunteer == "yes", "Volunteers", "Others")) %>%
  group_by(Region, Execution.Volunteer, Race, Sex) %>%
  count(Sex)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Groups the updated_data set by year and sex
sex_data <- updated_data %>%
  group_by(year, Sex)%>%
  # Find the number of executions for each sex and year
  summarize(Executions=n())
      
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Modify the updated data set to exemplify race
race_data <- updated_data %>%
  # Remove the small amount of NA data
  filter(!is.na(Race))%>%
  # Group by race and year to find number of executions of each race per year
  group_by(year, Race)%>%
  summarize(Executions=n())
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

share_race <- updated_data %>%
  filter(!is.na(Race)) %>%
  group_by(Race) %>%
  summarize(Executions = n()) %>%
  mutate(Total = sum(Executions)) %>%
  mutate(share = Executions / Total)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Create a dataset of the race of the victims per each execution
victims_data <- updated_data %>%
  # Utilize a case when statement to create a new column that contains the sex of victims
  mutate(Victim_Sex = case_when(
        Number.of.White.Female.Victims > 0 | Number.of.Black.Female.Victims > 0 | 
        Number.of.Other.Race.Female.Victims > 0 | Number.of.Latino.Female.Victims > 0 | 
        Number.of.Asian.Female.Victims > 0 | Number.of.American.Indian.or.Alaska.Native.Female.Victims > 0 ~ "Female",
        TRUE ~ "Male"
         ))%>%
  #select specified columns and record number of executions by grouped variables
  select(Victim.s..Race.s., Victim_Sex, year) %>%
  group_by(Victim.s..Race.s., year, Victim_Sex)%>%
  rename(Victim_Race = Victim.s..Race.s.) %>%
  summarize(Executions = n())

knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Comparison: Criminals Each Race Volunteered to Be Executed in Different Regions 
# Narrow down the dataset to only include certain variables 
exec_volunteer_modifiedyr <- updated_data %>%
  select(Execution.Volunteer, Race, Sex, Region, State, year) %>%
  # Select only males
  filter(Sex == "Male") %>%
  mutate(Execution.Volunteer = if_else(Execution.Volunteer == "yes", "Yes", "No")) 

# plotdata contains only the people who volunteered in the Execution.Volunteer=="Yes" and group the data by Region, Race, and year.
plotdata <- exec_volunteer_modifiedyr %>% 
  filter(Execution.Volunteer == "Yes") %>% 
  group_by(Region, Race, year) %>% 
  summarize(Executions = n())
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

share_volunteers <- updated_data %>%
  filter(!is.na(Execution.Volunteer))%>%
  group_by(Execution.Volunteer)%>%
  summarize(Executions=n())%>%
  mutate(Total = sum(Executions))%>%
  mutate(share = Executions / Total)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Create a variable named New_Region to combine region South and West
plotdata2 <- plotdata %>%
  mutate(New_Region = case_when(
    #Group the South/west together, and northeast and midwest together
    Region == "South" | Region == "West" ~ "South/West",
    Region != "South" & Region != "West" ~ "Northeast/Midwest"
  ))

knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

##create dataset that summarizes executions with respect to number of victims
number_victims <- updated_data %>%
  group_by(Number.of.Victims, )%>%
  summarize(Executions=n())
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Create state_data that contains excecutions per state
# State data groups data into workable dataset to make a map.

state_data <- updated_data %>%
  select(State)%>%
  group_by(State)%>%
  summarize(Executions = n()) %>%
  rename(state = State) %>%
  mutate(state = toupper(state)) %>%
  rename(Executions = Executions)

# US map of states and the number of executions per state is created within the year of 1977 and 2023. Gray states did not have death penalty between these years.
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# This the same code as previous, but variables are changed to show number of victims instead of executions.

state2_data <- updated_data %>%
  select(Number.of.Victims, State) %>%
  group_by(State) %>%
  summarize(num_vic = sum(Number.of.Victims)) %>%
  rename(state = State) %>%
  mutate(state = toupper(state)) %>%
  rename(Victims = num_vic)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# state_victims_data is the same as state_data with the addition of number of victim and year columns.

state_victims_data <- updated_data %>%
  select(State, year, Number.of.Victims)%>%
  group_by(year, State, Number.of.Victims)%>%
  summarize(Executions = n()) %>%
  rename(state = State) %>%
  mutate(state = toupper(state)) %>%
  drop_na()
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# ggpairs(updated_data, columns = c(2, 8, 9, 10, 27))
ggpairs(updated_data, columns = c(2, 8, 9, 27))
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

exec_per_year <- ggplot(yearly_executions, aes(x = year, y = Executions)) + 
    geom_col() + 
    labs(title = "Executions Per Year",
         x = "Year",
         y = "Number of Executions",
         caption = "Data from: U.S. Death Penalty Information Center")
plot(exec_per_year)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 
exec_per_sex <- ggplot(sex_data, aes(x = year,
                         y = Executions,
                         color = Sex)) +
    geom_line() +
    labs(title = "Executions of Each Sex Per Year",
      x = "Year",
      y = "Executions",
      caption = "Data from: U.S. Death Penalty Information Center")
plot(exec_per_sex)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

#Create a density plot of execution based on their sex
ggplot(sex_data, aes(x = year,
                     y = Sex,
                     fill = factor(stat(quantile)))) +
  stat_density_ridges(
  geom = "density_ridges_gradient", 
  calc_ecdf = TRUE,
  quantile_lines = TRUE,
  quantiles = c(0.25,0.5,0.9)
  ) +
  scale_fill_viridis_d(name = "Quantiles", 
                       labels =  c("25th", "50th", "90th", "100th"))+
  labs(title = "Executions of Each Sex Per Year",
       x = "Year",
       y = "Sex",
       caption = "Data from: U.S. Death Penalty Information Center")
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Create facet wrapped bar graphs of criminal's race over the years
race_exec_year <- ggplot(race_data, aes(x = year,
                      y = Executions)) +
      geom_col() +
      facet_wrap(~Race) +
      labs(title = "Executions of Each Race Per Year",
           x = "Year",
           y = "Number of Executions",
           caption = "Data from: U.S. Death Penalty Information Center")
plot(race_exec_year)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

race_pie <- ggplot(share_race,aes(x = "",
                      y=share,
                      fill = Race)) +
  geom_bar(stat = "identity",
           width = 1,
           color = "white") +
  coord_polar("y", start = 0) +
  theme_void() +
  labs(title = "Share of Executions Per Race",
       caption = "Data from: U.S. Death Penalty Information Center")
plot(race_pie)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Bar charts to show numbers of male criminals volunteered to be executed with facets of the region and race as there are not much female in the original dataset. 
ggplot(data = filter(exec_volunteer_region.race, 
                    Sex == "Male"), 

  mapping = aes(y = Execution.Volunteer,
                x = n)) + 
  geom_col() + 
  theme_minimal() +
      facet_wrap(~Race + Region) +
      labs(title = "Volunteers Based on Race and Region",
           y = "Criminals Volunteered to Be Executed",
           x = "Number of Execution Implemented",
           caption = "Data from: U.S. Death Penalty Information Center")
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

volunteer <- ggplot(share_volunteers,aes(x = "",
                            y = share,
                            fill = Execution.Volunteer)) +
  geom_bar(stat = "identity",
           width = 1, 
           color = "white") +
  coord_polar("y", start = 0) +
  theme_void() +
  labs(title = "Share of Volunteers",
       caption = "Data from: U.S. Death Penalty Information Center", fill = "Volunteer?")
plot(volunteer)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Make line graphs of each region's volunteered executions over the years
ggplot(plotdata, aes(year,
                     Executions,
                     color = Race)) +
  geom_line() +
  facet_wrap(~Region) +
  labs(title = "Criminals in Different Races that Volunteered to Be Executed Each Year",
       y = "Number of Volunteers ", 
       x = "Year",
       caption = "Data from: U.S. Death Penalty Information Center")

# Option for scales in facet: scales = "free_y"
# To have color=Race may not be a good idea as the "Volunteers" are not distribute 
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

ggplot(plotdata2, aes(year,
                      New_Region,
                      fill = factor(stat(quantile)))) +
  stat_density_ridges(
  geom = "density_ridges_gradient", 
  calc_ecdf = TRUE,
  quantile_lines = TRUE,
  quantiles = c(0.25, 0.5, 0.9)
  ) +
  scale_fill_viridis_d(name = "Quantiles",
                       labels =  c("25th", "50th", "90th", "100th"))+
  labs(title = "Criminals Volunteered to Be Executed", 
       y = "Number of Criminals Volunteered to Be Executed", 
       x = "Year",
       caption = "Source: U.S. Death Penalty Information Center") 
# The comparison is more obvious after the aggregation of South and West - the two regions with most executions (and also criminals volunteered to be executed).
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

#Create a column graph of number of executions vs number of victims
num_victimsPlot <- ggplot(number_victims, aes(x = Number.of.Victims,
                           y = Executions)) + 
  geom_col()+
  labs(title = "Number of Exections with Respect to Number of Victims",
       y = "Executions",
       x = "Number of Victims")

plot(num_victimsPlot)

knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

#Create a column graph of number of executions for the races of the victims over time
#Color was also used to represent sex
victim_race <- ggplot(victims_data, aes(x = year,
                         y = Executions,
                         color = Victim_Sex)) + 
  geom_col() + 
  facet_wrap(~Victim_Race)+
  labs(title = "Executions per Victims' Race",
       x = "year",
       y = "Number of Executions",
       color = "Victims' Sex")

plot(victim_race)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

#Create a column graph in order to show the victims' sex and its' relation to executions across all races
victim_sex <- ggplot(victims_data, aes(x = year,
                         y = Executions)) + 
  geom_col() + 
  facet_wrap(~Victim_Sex) + 
  labs(
       x = "Year", 
       y = "Number of Execution", 
       title = "Number of Executions by Sex of the Victim")
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Animated gif is created showing number of executions and number of victims plotted over the years. A normal plot is made first and then animated using animate(). This graph shows the executions each year and the number of victims each had. There is no correlation to the number of victims and executions. It appears to be the higher number of victims equals less exectuions that year and vice versa.

exec_gif <- ggplot(data = state_victims_data, 
                   mapping = aes(x = Executions, 
                                 y = Number.of.Victims)) +
    geom_point(shape = 8, 
               size = 5) +
    transition_time(as.integer(year)) +
    labs(
      title = "Year: {frame_time}",
      y = "Number of Victims"
      )

animate(exec_gif, duration = 15, fps = 5, width = 500, height = 500, renderer = gifski_renderer())
anim_save("output.gif")
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Plot_usmap creates a map joining the data from each state in state_data and graphs the map based on executions per state through the years.

usmap <- plot_usmap(regions = "states", 
                    data = state_data, 
                    values = "Executions") + 
  labs(
    title = "Number of Executions by State from 1977 to 2023")+ 
  theme(panel.background=element_blank()) +
  theme(legend.position = "right") +
  scale_fill_viridis_c()

# ggplotly creates an interactive map with executions

ggplotly(usmap) %>%
  highlight(
    "plotly_hover",
    selected = attrs_selected(line = list(color = "black"))
  )
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Similar map but with respect to victims
usmap2 <- plot_usmap(regions = "states", 
                    data = state2_data, 
                    values = "Victims") + 
  labs(
  title = "Number of Victims by State from 1977 to 2023") + 
  theme(panel.background = element_blank()) +
  theme(legend.position = "right") +
  scale_fill_viridis_c()

ggplotly(usmap2) %>%
  highlight(
    "plotly_hover",
    selected = attrs_selected(line = list(color = "black"))
  ) 
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 
plot(exec_per_year)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 
plot(exec_per_sex)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 
plot(race_pie)
plot(race_exec_year)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 
plot(volunteer)
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Bar charts to show numbers of male criminals volunteered to be executed with facets of the region and race as there are not much female in the original dataset. 
ggplot(data = filter(exec_volunteer_region.race, 
                    Sex == "Male"), 

  mapping = aes(y = Execution.Volunteer,
                x = n)) + 
  geom_col() + 
  theme_minimal() +
      facet_wrap(~Race + Region) +
      labs(title = "Volunteers Based on Race and Region",
           y = "Criminals Volunteered to Be Executed",
           x = "Number of Execution Implemented",
           caption = "Data from: U.S. Death Penalty Information Center")
knitr::opts_chunk$set(warning = FALSE, message = FALSE) 

# Make line graphs of each region's volunteered executions over the years
ggplot(plotdata, aes(year,
                     Executions,
                     color = Race)) +
  geom_line() +
  facet_wrap(~Region) +
  labs(title = "Criminals in Different Races that Volunteered to Be Executed Each Year",
       y = "Number of Volunteers ", 
       x = "Year",
       caption = "Data from: U.S. Death Penalty Information Center")

# Option for scales in facet: scales = "free_y"
# To have color=Race may not be a good idea as the "Volunteers" are not distribute 
    plot(num_victimsPlot)
    plot(victim_race)
  ggplotly(usmap) %>%
    highlight(
      "plotly_hover",
      selected = attrs_selected(line = list(color = "black"))
  )